home *** CD-ROM | disk | FTP | other *** search
/ Kompuutteri K-CD 2002 #1 / K-CD_2002-01.iso / Delphi / INSTALL / program files / Borland / Delphi6 / Demos / Swat / Main.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-05-22  |  6.1 KB  |  255 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ExtCtrls, Menus, StdCtrls;
  8.  
  9. const
  10.   crMaletUp : integer = 5;
  11.   crMaletDown : integer  = 6;
  12.   MissedPoints : integer  = -2;
  13.   HitPoints  : integer = 5;
  14.   MissedCritter : integer = -1;
  15.   CritterSize : integer = 72;
  16.   TimerId  : integer = 1;
  17.  
  18. type
  19.   THole = record
  20.     Time : integer;
  21.     Dead : boolean;
  22.   end;
  23.   
  24.   TSwatForm = class(TForm)
  25.     MainMenu1: TMainMenu;
  26.     Gamr1: TMenuItem;
  27.     New1: TMenuItem;
  28.     Options1: TMenuItem;
  29.     Stop1: TMenuItem;
  30.     Pause1: TMenuItem;
  31.     About1: TMenuItem;
  32.     Timer1: TTimer;
  33.     GameOverImage: TImage;
  34.     Image1: TImage;
  35.     TimeLabel: TLabel;
  36.     MissLabel: TLabel;
  37.     HitsLabel: TLabel;
  38.     EscapedLabel: TLabel;
  39.     ScoreLabel: TLabel;
  40.     procedure FormCreate(Sender: TObject);
  41.     procedure Timer1Timer(Sender: TObject);
  42.     procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
  43.       Shift: TShiftState; X, Y: Integer);
  44.     procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
  45.       Shift: TShiftState; X, Y: Integer);
  46.     procedure New1Click(Sender: TObject);
  47.     procedure Options1Click(Sender: TObject);
  48.     procedure Stop1Click(Sender: TObject);
  49.     procedure Pause1Click(Sender: TObject);
  50.     procedure About1Click(Sender: TObject);
  51.   private
  52.     { Private declarations }
  53.     Score : integer;
  54.     Hits, Miss, Escaped : integer;
  55.     IsGameOver, IsPause : Boolean;
  56.     Live : TBitmap;
  57.     Dead : TBitmap;
  58.     HoleInfo : array[0..4] of THole;
  59.     Holes : array[0..4] of TPoint;
  60.     procedure WriteScore;
  61.   public
  62.     { Public declarations }
  63.     LiveTime,  Frequence, GameTime : integer;
  64.   end;
  65.  
  66. var
  67.   SwatForm: TSwatForm;
  68.  
  69. implementation
  70.  
  71. uses options, about;
  72.  
  73. {$R *.dfm}
  74. {$R extrares.res}
  75.  
  76. procedure TSwatForm.FormCreate(Sender: TObject);
  77. begin
  78.   Holes[0] := Point( 10, 10 );
  79.   Holes[1] := Point( 200, 10 );
  80.   Holes[2] := Point( 100, 100 );
  81.   Holes[3] := Point( 10, 200 );
  82.   Holes[4] := Point( 200, 200 );
  83.  
  84.   Screen.Cursors[crMaletUp] := LoadCursor(HInstance, 'Malet');
  85.   Screen.Cursors[crMaletDown] := LoadCursor(HInstance, 'MaletDown');
  86.   Screen.Cursor := TCursor(crMaletUp);
  87.  
  88.   randomize;
  89.  
  90.   Live := TBitmap.Create;
  91.   Live.LoadFromResourceName(HInstance, 'Live');
  92.   Dead := TBitmap.Create;
  93.   Dead.LoadFromResourceName(HInstance, 'Dead');
  94.  
  95.   IsGameOver := true;
  96.   IsPause := false;
  97.   LiveTime := 10;
  98.   Frequence := 20;
  99.   GameTime := 150;        // fifteen seconds
  100.  
  101.   Application.OnMinimize := Pause1Click;
  102.   Application.OnRestore := Pause1Click;
  103. end;
  104.  
  105. procedure TSwatForm.Timer1Timer(Sender: TObject);
  106. var
  107.   i : integer;
  108. begin
  109.   Timer1.Tag := Timer1.Tag + 1;
  110.   i := random(Frequence);
  111.   if (i < 5) then
  112.   begin
  113.     if (HoleInfo[i].Time = 0) then
  114.     begin
  115.       HoleInfo[i].Time := Timer1.Tag + LiveTime;
  116.       HoleInfo[i].Dead := false;
  117.       Canvas.Draw(Holes[i].x, Holes[i].y, Live);
  118.     end;
  119.   end;
  120.   for i := 0 to 4 do
  121.   begin
  122.     if ( (Timer1.Tag > HoleInfo[i].Time ) and ( HoleInfo[i].Time <> 0 ) ) then
  123.     begin
  124.       HoleInfo[i].Time := 0;
  125.       if not(HoleInfo[i].Dead) then
  126.       begin
  127.         inc( Score, MissedCritter );
  128.         inc( Escaped );
  129.       end;
  130.       Canvas.FillRect(Rect(Holes[i].x, Holes[i].y, Holes[i].x + Dead.Width, Holes[i].y + Dead.Height));
  131.     end;
  132.   end;
  133.   WriteScore;
  134.   if (Timer1.Tag >= GameTime) then
  135.     Stop1Click(self);
  136. end;
  137.  
  138. procedure TSwatForm.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  139. var
  140.   i : integer;
  141.   hit : boolean;
  142. begin
  143.   Screen.Cursor := TCursor(crMaletDown);
  144.  
  145.   if (IsGameOver or IsPause) then
  146.     exit;
  147.  
  148.   hit := false;
  149.   for i := 0 to 4 do
  150.     if ( (not HoleInfo[i].Dead) and (HoleInfo[i].Time <> 0) ) then
  151.       if (X > Holes[i].x ) and ( X < (Holes[i].x + Live.Width) ) and
  152.          ( Y > Holes[i].y ) and ( Y < (Holes[i].y + Live.Height)) then
  153.       begin
  154.         inc( Score, HitPoints );
  155.         HoleInfo[i].Dead := true;
  156.         HoleInfo[i].Time := Timer1.Tag + 2 * LiveTime;
  157.         inc( Hits );
  158.         hit := true;
  159.         Canvas.Draw(Holes[i].x, Holes[i].y, Dead);
  160.       end;
  161.   if not(hit) then
  162.   begin
  163.     inc ( Score, MissedPoints );
  164.     inc( Miss );
  165.   end;
  166.   WriteScore;
  167. end;
  168.  
  169. procedure TSwatForm.FormMouseUp(Sender: TObject; Button: TMouseButton;
  170.   Shift: TShiftState; X, Y: Integer);
  171. begin
  172.   Screen.Cursor := TCursor(crMaletUp);
  173. end;
  174.  
  175. procedure TSwatForm.New1Click(Sender: TObject);
  176. begin
  177.   Timer1.Enabled := true;
  178.   Timer1.Tag := 0;
  179.   Score := 0;
  180.   Hits := 0;
  181.   Miss := 0;
  182.   Escaped := 0;
  183.   if (IsPause)
  184.   then begin
  185.     IsPause := false;
  186.     Pause1.Caption := '&Pause';
  187.   end;
  188.   GameOverImage.Visible := false;
  189.   IsGameOver := false;
  190.   FillChar(HoleInfo, sizeof(HoleInfo), 0);
  191.   New1.Enabled := false;
  192.   Options1.Enabled := false;
  193.   Stop1.Enabled := true;
  194. end;
  195.  
  196. procedure TSwatForm.Options1Click(Sender: TObject);
  197. begin
  198.   OptionsDlg.ShowModal;
  199. end;
  200.  
  201. procedure TSwatForm.Stop1Click(Sender: TObject);
  202. var
  203.  i : integer;
  204. begin
  205.   Timer1.Enabled := false;
  206.   IsPause := false;
  207.   GameOverImage.Visible := true;
  208.   IsGameOver := true;
  209.   Timer1.Tag := GameTime;
  210.   New1.Enabled := true;
  211.   Options1.Enabled := true;
  212.   Stop1.Enabled := false;
  213.   for i := 0 to 4 do
  214.     if (HoleInfo[i].Time <> 0) then
  215.       Canvas.FillRect(Rect(Holes[i].x, Holes[i].y, Holes[i].x + Dead.Width,
  216.         Holes[i].y + Dead.Height));
  217. end;
  218.  
  219. procedure TSwatForm.Pause1Click(Sender: TObject);
  220. begin
  221.   if (IsGameOver) then
  222.     exit;
  223.  
  224.   if (IsPause) then
  225.   begin
  226.     IsPause := false;
  227.     Pause1.Caption := '&Pause';
  228.     Stop1.Enabled := true;
  229.     Timer1.Enabled := true;
  230.   end
  231.   else
  232.   begin
  233.     IsPause := true;
  234.     Pause1.Caption := '&Continue';
  235.     Stop1.Enabled := false;
  236.     Timer1.Enabled := false;
  237.   end;
  238. end;
  239.  
  240. procedure TSwatForm.About1Click(Sender: TObject);
  241. begin
  242.   AboutBox.ShowModal;
  243. end;
  244.  
  245. procedure TSwatForm.WriteScore;
  246. begin
  247.   TimeLabel.Caption := IntToStr(GameTime - Timer1.Tag);
  248.   HitsLabel.Caption := IntToStr(Hits);
  249.   MissLabel.Caption := IntToStr(Miss);
  250.   EscapedLabel.Caption := IntToStr(Escaped);
  251.   ScoreLabel.Caption := IntToStr(Score);
  252. end;
  253.  
  254. end.
  255.